10 REM  ///// INCOME AVERAGING /////
20 REM  CLEAR SCREEN
30 CLS
40 KEY OFF
50 PRINT SPC(32)
60 COLOR 1:PRINT "Income Averaging":COLOR 7
70 REM  ROUNDOFF FUNCTION            '70 REM ROUND OFF TO WHOLE DOLLARS
80 DEF FNR(X)=INT(100*X+.5)/100      'DEF FNR (X)=INT(X+0.5)
90 PU$="$$###,###.##"                'PU$="  $$,###,###"
100 REM  A() HOLDS SCHEDULE G AMOUNTS
110 REM  B(), C() AND R() ARE FOR TAX RATE SCHEDULES
120 DIM A(46),B(4,16),C(4,16),R(4,16)
130 REM  READ TAX RATE SCHEDULES
140 GOSUB 2970
150 REM  CLEAR SCHEDULE G FOR NEXT TAXPAYER
160 FOR I=1 TO 46
170 A(I)=0
180 NEXT I
190 PRINT
200 PRINT "Enter taxpayer's name: ";
210 LINE INPUT; Z$
220 PRINT
230 PRINT "   Enter taxable year:";
240 INPUT " ",A(1)
250 IF A(1)>1980 THEN 280
260 PRINT "This program is for the years 1981 and thereafter."
270 GOTO 220
280 PRINT
290 PRINT "Enter filing status ..."
300 PRINT "   1 for Single"
310 PRINT "   2 for Married/Joint"
320 PRINT "   3 for Married/Separate"
330 PRINT "   4 for Head of Household"
340 PRINT "   5 for Qualifying Widow(er)"
350 INPUT " "; F
360 IF F<1 OR F>5 THEN PRINT "Please, 1 through 5 only.":GOTO 280
370 PRINT
380 REM
390 REM  **** BASE PERIOD INCOME AND ADJUSTMENTS ****
400 REM
410 REM  ENTER INCOME AMOUNTS--
420 PRINT "Enter the amount from:"
430 PRINT " Form 1040--line 34"
440 PRINT " Form 1040A (1977 and 1978)--line 10"
450 PRINT " Form 1040A (1979 and 1980)--line 11"
460 PRINT
470 FOR J=1 TO 4
480 PRINT "for"; A(1)-J;
490 INPUT ;""; A(J+1)
500 PRINT TAB(21)
510 PRINT "How many exemptions were claimed";
520 INPUT B
530 REM  EXEMPTIONS ARE $1000 EACH 1979 & AFTER, $750 EACH BEFORE 1979
540 A(J+5)=1000*B
550 IF A(1)-J>1978 THEN 570
560 A(J+5)=750*B
570 A(J+9)=A(J+1)-A(J+5)
580 NEXT J
590 PRINT
600 PRINT "Most taxpayers don't have excluded foreign income,"
610 PRINT "  amounts subject to a penalty under section 72(m)(5),"
620 PRINT "  or excess community income."
630 PRINT "Do you have any of these items (Y/N)";
640 INPUT W$
650 PRINT
660 IF W$="N" OR W$="n" THEN 790
670 FOR I=1 TO 4
680 PRINT "Excluded foreign income for"; A(1)-I;
690 INPUT A(15+I)
700 IF A(15+I)<0 THEN PRINT "Can not be less than zero.":GOTO 680
710 NEXT
720 PRINT
730 PRINT "Enter amounts subject to penalty, section 72(m)(5)";
740 INPUT A(20)
750 PRINT SPC(21)"Enter excess community income";
760 INPUT A(21)
770 PRINT
780 REM  ADD UP BASE PERIOD INCOME COLUMNS (a) THROUGH (d)
790 A(22)=A(10)+A(16)
800 A(23)=A(11)+A(17)
810 A(24)=A(12)+A(18)
820 A(25)=A(13)+A(19)
830 REM  BASE PERIOD INCOME CANNOT BE NEGATIVE
840 FOR I=22 TO 25
850 IF A(I)>0 THEN 870
860 A(I)=0
870 NEXT I
880 REM
890 REM  **** COMPUTATION OF AVERAGABLE INCOME ****
900 REM
910 REM  6. TAXABLE INCOME FROM FORM 1040, LINE 34
920 PRINT "Enter taxable income for"; A(1);
930 INPUT A(26)
940 PRINT
950 REM  8. SUBTRACT LINE 7 FROM LINE 6
960 A(27)=A(26)-A(20)
970 REM  9. EXCESS COMMUNITY INCOME IS A(21)
980 REM  10. ADJUSTED TAXABLE INCOME
990 A(28)=A(27)-A(21)
1000 REM  LINE 10 CANNOT BE NEGATIVE
1010 IF A(28)>=0 THEN 1040
1020 A(28)=0
1030 REM  11. TOTAL BASE PERIOD INCOME
1040 A(29)=A(22)+A(23)+A(24)+A(25)
1050 REM 12. 30% OF LINE 11
1060 A(30)=FNR(A(29)*.3)
1070 REM  13. AVERAGEABLE INCOME
1080 A(31)=A(28)-A(30)
1090 IF A(31)>3000 THEN 1210
1100 PRINT Z$;
1110 PRINT " does NOT qualify for averaging."
1120 PRINT "Averageable income for"; A(1); "is ";
1130 PRINT USING "$$#,###"; A(31);:PRINT ","
1140 PRINT SPC(22)"which is  $3,000 or less."
1150 PRINT
1160 GOTO 2420
1170 REM
1180 REM  **** COMPUTATION OF TAX ****
1190 REM
1200 REM  14. AMOUNT FROM LINE 12
1210 A(32)=A(30)
1220 REM  15. 20% OF LINE 13
1230 A(33)=FNR(A(31)*.2)
1240 REM  16. TOTAL (ADD LINES 14 AND 15)
1250 A(34)=A(32)+A(33)
1260 REM  17. EXCESS COMMUNITY INCOME IS A(21)
1270 REM  18. TOTAL (ADD LINES 16 AND 17)
1280 A(35)=A(34)+A(21)
1290 REM  19. TAX ON LINE 18 AMOUNT
1300 S=A(35)
1310 GOSUB 2660
1320 A(36)=T
1330 REM  20. TAX ON LINE 16 AMOUNT
1340 S=A(34)
1350 GOSUB 2660
1360 A(37)=T
1370 REM  21. TAX ON LINE 14 AMOUNT
1380 S=A(32)
1390 GOSUB 2660
1400 A(38)=T
1410 REM  22. SUBTRACT LINE 21 FROM LINE 20
1420 A(39)=A(37)-A(38)
1430 REM  23. MULTIPLY LINE 22 AMOUNT BY 4
1440 A(40)=4*A(39)
1450 REM  IF NO SECTION 72(m)(5) PENALTY INCOME, SKIP TO LINE 28
1460 IF A(20)=0 THEN 1580
1470 REM  24. TAX ON LINE 6 AMOUNT
1480 S=A(26)
1490 GOSUB 2660
1500 A(41)=T
1510 REM  25. TAX ON LINE 8 AMOUNT
1520 S=A(27)
1530 GOSUB 2660
1540 A(42)=T
1550 REM  26. SUBTRACT LINE 25 FROM LINE 24
1560 A(43)=A(41)-A(42)
1570 REM  27.  ADD LINES 19, 23 AND 26
1580 A(44)=A(36)+A(40)+A(43)
1590 REM  28. MULTIPLY LINE 27 BY .0125
1600 A(45)=A(44)*.0125
1610 REM  29. TAX (SUBTRACT LINE 28 FROM LINE 27)
1620 A(46)=A(44)-A(45)
1630 REM
1640 REM  **** PRINT SCHEDULE G ****
1650 REM
1660 PRINT "For ";Z$;". the tax for";A(1);
1670 PRINT "using income averaging,"
1680 PRINT "comes to"; : PRINT USING PU$; A(46)
1690 PRINT "THE FOLLOWING REPRESENTS THE FILLED-IN";
1700 PRINT " SCHEDULE G USING THE 1981 FORMAT:"
1710 PRINT
1720 PRINT " SCHEDULE G"SPC(17)"Income Averaging"SPC(22) A(1)
1730 PRINT Z$;TAB(31)
1740 PRINT "Filing status: ";
1750 ON F GOTO 1760,1780,1800,1820,1840
1760 PRINT "Single"
1770 GOTO 1850
1780 PRINT "Married/Joint"
1790 GOTO 1850
1800 PRINT "Married/Separate"
1810 GOTO 1850
1820 PRINT "Unmarried Head of Household"
1830 GOTO 1850
1840 PRINT "Qualifying Widow(er)"
1850 PRINT "Base Period";
1860 PRINT SPC(20)"(a)"SPC(9)"(b)"SPC(9)"(c)"SPC(9)"(d)"
1870 PRINT "Income and Adjustments ";
1880 FOR I=1 TO 4
1890 PRINT SP(6) A(1)-I;
1900 NEXT
1910 PRINT
1920 REM  PRINT LINE 1
1930 I=2:J=1
1940 GOSUB 2490
1950 REM  PRINT LINES 2a AND 2b
1960 PRINT "Line  2a"TAB(24)
1970 FOR J=1 TO 4
1980 IF A(1)-J<1979 THEN PRINT USING PU$; A(5+J); ELSE PRINT SPC(12)
1990 NEXT
2000 PRINT
2010 PRINT "Line  2b"TAB(24)
2020 FOR J=1 TO 4
2030 IF A(1)-J>1978 THEN PRINT USING PU$; A(5+J); ELSE PRINT SPC(12)
2040 NEXT
2050 PRINT
2060 REM  PRINT LINE 3
2070 I=10:J=3
2080 GOSUB 2490
2090 REM  PRINT LINE 4
2100 I=16:J=4
2110 GOSUB 2490
2120 REM  PRINT LINE 5
2130 I=22:J=5
2140 GOSUB 2490
2150 PRINT "Computation of Averageable Income"
2160 PRINT "Line  6"TAB(60):PRINT USING PU$; A(26)
2170 PRINT "Line  7"TAB(60):PRINT USING PU$; A(20)
2180 PRINT "Line  8"TAB(60):PRINT USING PU$; A(27)
2190 PRINT "Line  9"TAB(60):PRINT USING PU$; A(21)
2200 FOR J=10 TO 13
2210 PRINT "Line";J;
2220 IF J=11 THEN PRINT TAB(48) ELSE PRINT TAB(60)
2230 PRINT USING PU$; A(J+18)
2240 NEXT J
2250 REM  WAIT FOR OPERATOR CUE TO CONTINUE
2260 GOSUB 2590
2270 PRINT "Computation of Tax"
2280 FOR J=14 TO 16
2290 PRINT "Line";J;TAB(60):PRINT USING PU$; A(J+18)
2300 NEXT J
2310 PRINT "Line 17"TAB(60):PRINT USING PU$; A(21)
2320 FOR J=18 TO 29
2330 PRINT "Line";J;
2340 IF J>19 AND J<23 OR J=24 OR J=25 THEN PRINT TAB(48):GOTO 2360
2350 PRINT TAB(60)
2360 PRINT USING PU$; A(J+17)
2370 NEXT J
2380 PRINT
2390 PRINT STRING$(26,"*")" END OF SCHEDULE G "STRING$(26,"*")
2400 PRINT
2410 REM  WAIT BEFORE ERASING SCREEN FOR NEXT TAXPAYER
2420 PRINT "Enter 'C' to continue with next taxpayer. ";
2430 INPUT "",W$
2440 IF W$="C" OR W$="c" THEN CLS:GOTO 160
2450 END
2460 REM
2470 REM  *** SUBROUTINE TO PRINT ALL OF LINE 1,3,4 OR 5 ***
2480 REM
2490 PRINT "Line "; J; TAB(24)
2500 FOR J=0 TO 3
2510 PRINT USING PU$; A(I+J);
2520 NEXT J
2530 PRINT
2540 RETURN
2550 REM
2560 REM  *** SUBROUTINE TO WAIT FOR OPERATOR CUE TO CONTINUE
2570 REM    SINCE ENTIRE SCHEDULE G DOESN'T FIT ON ONE SCREEN ***
2580 REM
2590 PRINT "Press [RETURN] to continue. ";
2600 INPUT "",W$
2610 RETURN
2620 REM
2630 REM  *** SUBROUTINE TO CALCULATE TAX ON AMOUNT S ***
2640 REM
2650 REM  INITIALIZE TAX TO ZERO
2660 T=0
2670 REM  SINGLE HAS 16 BRACKETS, ALL OTHERS HAVE 15
2680 K=15
2690 IF F>1 THEN 2720
2700 K=16
2710 REM  DETERMINE WHETHER TO USE SCHEDULE X, Y OR Z
2720 I=F
2730 REM  WIDOW(ER) SAME AS MARRIED/JOINT
2740 IF F<5 THEN 2770
2750 I=2
2760 REM  START WITH ZERP BRACLET A,PIMT
2770 J=1
2780 REM  IS INCOME <= ZERO BRACKET AMOUNT?
2790 IF S<=C(I,J) THEN 2920
2800 REM IS INCOME > THIS BRACKET'S CEILING?
2810 IF S>C(I,J+1) THEN 2870
2820 REM  FOUND PROPER TAX BRACKET--
2830 REM  --COMPUT TAX ON BALANCE OF INCOME
2840 T=(S-C(I,J))*R(I,J)/100+B(I,J)
2850 GOTO 2920
2860 REM  PROCEED TO NEXT BRACKET
2870 J=J+1
2880 IF J<K THEN 2810
2890 REM  TAX ON BALANCE OF INCOME IS AT HIGHEST RATE
2900 GOTO 2840
2910 REM  ROUND TAX AMOUNT
2920 T=FNR(T)
2930 RETURN
2940 REM
2950 REM  ***   SUBROUTINE TO READ TAX RATES   ***
2960 REM
2970 RESTORE
2980 REM  FIRST SCHEDULE X
2990 FOR J=1 TO 16
3000 READ B(1,J),R(1,J),C(1,J)
3010 NEXT J
3020 REM  THEN SCHEDULES Y & Z
3030 FOR I=2 TO 4
3040 FOR J=1 TO 15
3050 READ B(I,J),R(I,J),C(I,J)
3060 NEXT J
3070 NEXT I
3080 RETURN
3090 REM
3100 REM  ***** 1979 TAX RATE SCHEDULES X, Y AND Z *****
3110 REM
3120 REM  FOR EACH TABLE BELOW, GET BASE, RATE AND
3130 REM  CUTOFF DATA TRIPLET FROM THE RIGHTMOST THREE
3140 REM  COLUMNS OF THE APPROPRIATE SCHEDULE
3150 REM
3160 REM  ----SCHEDULE X (SINGLE TAXPAYERS)----
3170 REM
3180 DATA 0,14,2300,154,16,3400,314,18,4400,692,19,6500,1072,21,8500
3190 DATA 1555,24,10800,2059,26,12900,2605,30,15000,3565,34,18200
3200 DATA 5367,39,23500,7434,44,28800,9766,49,34100,13392,55,41500
3210 DATA 20982,63,55300,37677,68,81800,55697,70,108300
3220 REM
3230 REM  ----SCHEDULE Y (JOINT/WIDOW)----
3240 REM
3250 DATA 0,14,3400,294,16,5500,630,18,7600,1404,21,11900,2265,24,16000
3260 DATA 3273,28,20200,4505,32,24600,6201,37,29900,8162,43,35200,12720
3270 DATA 49,45800,19678,54,60000,33502,59,85600,47544,64,109400
3280 DATA 81464,68,162400,117504,70,215400
3290 REM
3300 REM  ----SCHEDULE Y (SEPARATE)----
3310 REM
3320 DATA 0,14,1700,147,16,2750,315,18,3800,702,21,5950,1132.50,24,8000
3330 DATA 1636.50,28,10100,2252.50,32,12300,3100.50,37,14950,4081,43
3340 DATA 17600,6360,49,22900,9839,54,30000,16751,59,42800,23772,64
3350 DATA 54700,40732,68,81200,58752,70,107700
3360 REM
3370 REM  ----SCHEDULE Z (UNMARRIED HEAD OF HOUSEHOLD)----
3380 REM
3390 DATA 0,14,2300,294,16,4400,630,18,6500,1026,22,8700,1708,24,11800
3400 DATA 2476,26,15000,3308,31,18200,4951,36,23500,6859,42,28800,9085
3410 DATA 46,34100,13961,54,44700,22547,59,60600,35055,63,81800,51750
3420 DATA 68,108300,87790,70,161300
3430 END
